Obiettivo: Sviluppare uno score composito di raccomandazione di prodotti per un cliente con cui un agente, capo agenzia ecc. può valutare la Next Best Action ai fini di Cross-Selling.
\[ \text{Score}(c, p) = w_1 \cdot \text{Compatibilità} + w_2 \cdot \text{Redditività} + w_3 \cdot \text{Retention} + w_4 \cdot \text{ProbConversione} \]
Ogni componente ha un peso a cui l’utente può assegnare un valore in base alle esigenze del momento (es: retention vs massima redditività vs probabilità di conversione).
library(dplyr)
library(ggplot2)
library(corrplot)
library(rpart)
library(rpart.plot)
library(factoextra)
library(cluster)
library(tidyr)
library(car)
library(MASS)
library(caret)
library(randomForest)
library(fastshap)
library(shapviz)
setwd("/Users/andrea/Progetti/generali/data/raw")
# Caricamento dataset
abitazioni <- read.csv("abitazioni.csv")
clienti <- read.csv("clienti.csv")
competitor_prodotti <- read.csv("competitor_prodotti.csv")
interazioni_clienti <- read.csv("interazioni_clienti.csv")
polizze <- read.csv("polizze.csv")
reclami <- read.csv("reclami.csv")
sinistri <- read.csv("sinistri.csv")
# Formattazione variabili
clienti$Data_Ultima_Visita <- as.Date(clienti$Data_Ultima_Visita)
clienti$Mesi_Ultima_Visita <- as.numeric(difftime(
as.Date("2025-12-01"),
clienti$Data_Ultima_Visita,
units = "days"
)) / 30.44
clienti$Agenzia <- as.factor(clienti$Agenzia)
clienti$Stato.Civile <- as.factor(clienti$Stato.Civile)
clienti$Professione <- as.factor(clienti$Professione)
clienti$Cluster_Risposta <- as.factor(clienti$Cluster_Risposta)
clienti$Zona.di.Residenza <- as.factor(clienti$Zona.di.Residenza)
interazioni_clienti$Data_Interazione <- as.Date(interazioni_clienti$Data_Interazione)
interazioni_clienti$Tipo_Interazione <- as.factor(interazioni_clienti$Tipo_Interazione)
interazioni_clienti$Motivo <- as.factor(interazioni_clienti$Motivo)
interazioni_clienti$Esito <- as.factor(interazioni_clienti$Esito)
interazioni_clienti$Conversione <- as.factor((interazioni_clienti$Conversione))
interazioni_clienti$Note[interazioni_clienti$Note == ""] <- NA
interazioni_clienti$Note <- as.factor(interazioni_clienti$Note)
polizze <- polizze[,-c(1)]
polizze$Prodotto <- as.factor(polizze$Prodotto)
polizze$Area.di.Bisogno <- as.factor(polizze$Area.di.Bisogno)
polizze$Data.di.Emissione <- as.Date(polizze$Data.di.Emissione)
polizze$Data_Scadenza <- as.Date(polizze$Data_Scadenza)
polizze$Canale_Acquisizione <- as.factor(polizze$Canale_Acquisizione)
polizze$Loss_Ratio <- as.numeric(polizze$Loss_Ratio)
polizze$Stato_Polizza <- as.factor(polizze$Stato_Polizza)
polizze$Importo_Liquidato <- NULL
reclami$Prodotto <- as.factor(reclami$Prodotto)
reclami$Area.di.Bisogno <- as.factor(reclami$Area.di.Bisogno)
reclami$Reclami_e_info <- as.factor(reclami$Reclami_e_info)
sinistri$Prodotto <- as.factor(sinistri$Prodotto)
sinistri$Area.di.Bisogno <- as.factor(sinistri$Area.di.Bisogno)
sinistri$Sinistro <- as.factor(sinistri$Sinistro)
sinistri$Data_Sinistro <- as.Date(sinistri$Data_Sinistro)
sinistri$Stato_Liquidazione <- as.factor(sinistri$Stato_Liquidazione)
sinistri <- sinistri[!is.na(sinistri$Data_Sinistro), ]
reclami <- reclami[!(reclami$Reclami_e_info == ""), ]
# Classificazione variabili
campi_calcolati <- c(
"Reddito.Stimato", "Patrimonio.Finanziario.Stimato", "Patrimonio.Reale.Stimato",
"Consumi.Stimati", "Propensione.Acquisto.Prodotti.Vita", "Propensione.Acquisto.Prodotti.Danni",
"Probabilità.Furti.Stimata", "Probabilità.Rapine.Stimata", "Engagement_Score",
"Churn_Probability", "CLV_Stimato", "Potenziale_Crescita", "Satisfaction_Score",
"Cluster_Risposta"
)
campi_identificativi <- c("Nome", "Cognome", "codice_cliente", "Data_Ultima_Visita")
campi_numerosi <- c("Luogo.di.Nascita", "Luogo.di.Residenza", "Agenzia", "Latitudine", "Longitudine")
clienti_rid <- clienti[, !(names(clienti) %in% c(campi_numerosi, campi_identificativi))]
campi_dati <- setdiff(names(clienti_rid), campi_calcolati)
Caricamento dei dati e loro formattazione per usabilità su R. Pulizia di colonne e righe non utili, calcolo di colonne utili.
Alcune variabili sono dati grezzi, altri sono indici, probabilità, calcoli non documentati.
L’idea è di provare a usare X-AI per capire cosa possa essere usato nei calcoli “black box”
Classificazione Variabili:
Comprendere come sono calcolati gli score pre-esistenti (Engagement, Churn, ecc.) e le relazioni tra variabili, per evitare di creare calcoli circolari e altri problemi
campi_dati_num <- campi_dati[sapply(clienti_rid[, campi_dati], is.numeric)]
campi_calc_num <- campi_calcolati[sapply(clienti_rid[, campi_calcolati], is.numeric)]
cor_reverse <- cor(clienti_rid[, campi_dati_num],
clienti_rid[, campi_calc_num],
use = "pairwise.complete.obs")
cor_reverse_dati <- cor(clienti_rid[, campi_dati_num],
clienti_rid[, campi_dati_num],
use = "pairwise.complete.obs")
cor_reverse_calc <- cor(clienti_rid[, campi_calc_num],
clienti_rid[, campi_calc_num],
use = "pairwise.complete.obs")
corrplot(cor_reverse, method = "number", number.cex = 0.6, tl.cex = 0.7,
title = "Correlazione: Dati vs Campi Calcolati", mar=c(0,0,2,0))
corrplot(cor_reverse_dati, method = "color", type = "upper", tl.cex = 0.7,
title = "Correlazione: Campi Dati", mar=c(0,0,2,0))
corrplot(cor_reverse_calc, method = "number", number.cex = 0.7, tl.cex = 0.7,
title = "Correlazione: Campi Calcolati", mar=c(0,0,2,0))
Osservazioni:
Creazione di un albero surrogato per Engagement_Score usando solo campi_dati:
formula_data <- clienti_rid[, c("Engagement_Score", campi_dati)]
tree_engagement <- rpart(
Engagement_Score ~ .,
data = formula_data,
method = "anova",
control = rpart.control(
minsplit = 20,
cp = 0.01,
maxdepth = 5,
usesurrogate = 2,
maxsurrogate = 5
)
)
rpart.plot(tree_engagement, extra = 101, box.palette = "auto",
main = "Albero Surrogato: Engagement_Score")
var_importance <- tree_engagement$variable.importance
var_importance_df <- data.frame(
Variable = names(var_importance),
Importance = as.numeric(var_importance)
) %>% arrange(desc(Importance))
ggplot(var_importance_df[1:10,], aes(x = reorder(Variable, Importance), y = Importance)) +
geom_col(fill = "steelblue") +
coord_flip() +
labs(title = "Top 10 Variabili per Importanza (rpart)",
x = "Variabile", y = "Importanza") +
theme_minimal()
set.seed(42)
# Usa un campione per velocizzare il calcolo
n_sample <- min(500, nrow(clienti_rid))
sample_idx <- sample(1:nrow(clienti_rid), n_sample)
clienti_sample <- clienti_rid[sample_idx, ]
surrogato_rf_eng <- randomForest(
Engagement_Score ~ .,
data = clienti_rid[, c("Engagement_Score", campi_dati)],
ntree = 100, # Ridotto da 200
importance = TRUE
)
r2_eng <- cor(predict(surrogato_rf_eng), clienti_rid$Engagement_Score)^2
cat("R² modello surrogato Engagement:", round(r2_eng, 3), "\n")
pfun <- function(object, newdata) predict(object, newdata)
# Calcola SHAP solo su campione
shap_vals_eng <- explain(
surrogato_rf_eng,
X = clienti_sample[, campi_dati],
pred_wrapper = pfun,
nsim = 10
)
shap_obj_eng <- shapviz(shap_vals_eng, X = clienti_sample[, campi_dati])
sv_importance(shap_obj_eng, kind = "bar")
set.seed(42)
# Usa un campione per velocizzare il calcolo
n_sample <- min(500, nrow(clienti_rid))
sample_idx <- sample(1:nrow(clienti_rid), n_sample)
clienti_sample <- clienti_rid[sample_idx, ]
surrogato_rf_churn <- randomForest(
Churn_Probability ~ .,
data = clienti_rid[, c("Churn_Probability", campi_dati)],
ntree = 100, # Ridotto da 200
importance = TRUE
)
r2_churn <- cor(predict(surrogato_rf_churn), clienti_rid$Churn_Probability)^2
cat("R² modello surrogato Churn:", round(r2_churn, 3), "\n")
# Calcola SHAP solo su campione con nsim ridotto
shap_vals_churn <- explain(
surrogato_rf_churn,
X = clienti_sample[, campi_dati],
pred_wrapper = pfun,
nsim = 20 # Ridotto da 100
)
shap_obj_churn <- shapviz(shap_vals_churn, X = clienti_sample[, campi_dati])
sv_importance(shap_obj_churn, kind = "bar")
Risultati:
Trovare gruppi di clienti simili per analisi interna e calcolo del punteggio di affinità.
clus_df <- clienti %>%
dplyr::select(
Età, Reddito.Familiare, Numero.Figli, Anzianità.con.la.Compagnia,
Valore.Immobiliare.Medio, Probabilità.Furti.Stimata, Probabilità.Rapine.Stimata,
Engagement_Score, Satisfaction_Score
)
clus_df_scaled <- scale(clus_df)
# K-means con diverse k
kmeans_clust7 <- kmeans(clus_df_scaled, centers = 7, nstart = 15)
kmeans_clust5 <- kmeans(clus_df_scaled, centers = 5, nstart = 15)
kmeans_clust3 <- kmeans(clus_df_scaled, centers = 3, nstart = 15)
# Silhouette analysis
sil7 <- silhouette(kmeans_clust7$cluster, dist(clus_df_scaled))
sil5 <- silhouette(kmeans_clust5$cluster, dist(clus_df_scaled))
sil3 <- silhouette(kmeans_clust3$cluster, dist(clus_df_scaled))
pca <- prcomp(clus_df_scaled)
df_pca <- pca$x[, 1:3]
km_pca <- kmeans(df_pca, centers = 4, nstart = 25)
sil_pca <- silhouette(km_pca$cluster, dist(df_pca))
varianza_spiegata <- cumsum(pca$sdev^2 / sum(pca$sdev^2))[1:3]
cat("Varianza spiegata dalle prime 3 componenti:", round(varianza_spiegata[3]*100, 1), "%\n")
## Varianza spiegata dalle prime 3 componenti: 71.1 %
fviz_silhouette(sil_pca) +
labs(title = "Analisi Silhouette - 4 Cluster su PCA",
subtitle = paste("Silhouette medio:", round(mean(sil_pca[, 3]), 3)))
## cluster size ave.sil.width
## 1 1 4988 0.49
## 2 2 4199 0.40
## 3 3 599 0.72
## 4 4 1414 0.50
Risultati Migliori:
clienti_clustered <- cbind(clienti, Cluster = sil_pca[,1])
clienti_clustered_polizze <- merge(clienti_clustered, polizze, by = "codice_cliente")
polizze_scarto <- clienti_clustered_polizze %>%
count(Cluster, Prodotto, name = "n_utenti_cluster") %>%
group_by(Cluster) %>%
mutate(pct_cluster = (n_utenti_cluster / sum(n_utenti_cluster)) * 100) %>%
ungroup() %>%
left_join(
clienti_clustered_polizze %>%
count(Prodotto, name = "n_totale_prodotto") %>%
mutate(pct_globale = (n_totale_prodotto / sum(n_totale_prodotto)) * 100) %>%
dplyr::select(Prodotto, pct_globale),
by = "Prodotto"
) %>%
mutate(scarto = pct_cluster - pct_globale) %>%
arrange(Cluster, desc(scarto))
print(polizze_scarto)
## # A tibble: 20 × 6
## Cluster Prodotto n_utenti_cluster pct_cluster pct_globale scarto
## <dbl> <fct> <int> <dbl> <dbl> <dbl>
## 1 1 Polizza Salute e In… 1935 34.4 28.7 5.69
## 2 1 Polizza Vita a Prem… 786 14.0 10.3 3.66
## 3 1 Assicurazione Casa … 1611 28.7 30.6 -1.92
## 4 1 Polizza Vita a Prem… 497 8.85 11.8 -2.97
## 5 1 Piano Individuale P… 789 14.0 18.5 -4.47
## 6 2 Assicurazione Casa … 2956 34.7 30.6 4.08
## 7 2 Piano Individuale P… 1898 22.3 18.5 3.75
## 8 2 Polizza Vita a Prem… 971 11.4 11.8 -0.423
## 9 2 Polizza Salute e In… 2167 25.4 28.7 -3.33
## 10 2 Polizza Vita a Prem… 533 6.25 10.3 -4.08
## 11 3 Polizza Vita a Prem… 160 26.7 10.3 16.4
## 12 3 Polizza Vita a Prem… 147 24.5 11.8 12.7
## 13 3 Piano Individuale P… 116 19.4 18.5 0.856
## 14 3 Assicurazione Casa … 102 17.0 30.6 -13.6
## 15 3 Polizza Salute e In… 74 12.4 28.7 -16.4
## 16 4 Polizza Vita a Prem… 516 15.7 11.8 3.84
## 17 4 Polizza Salute e In… 1010 30.6 28.7 1.89
## 18 4 Polizza Vita a Prem… 385 11.7 10.3 1.34
## 19 4 Piano Individuale P… 536 16.3 18.5 -2.25
## 20 4 Assicurazione Casa … 850 25.8 30.6 -4.81
Note: Scarto e penetrazione nel cluster sono gli indici di affinità. Considerare rimozione propensioni pre-calcolate per evitare di combinare propensioni con anagrafica.
Analisi di Churn e Retention. Ottenere un parametro Δ che misura l’impatto sulla retention di vendere un nuovo prodotto.
retention_by_product <- polizze %>%
left_join(clienti, by = "codice_cliente") %>%
group_by(Area.di.Bisogno) %>%
summarise(
avg_churn = mean(Churn_Probability, na.rm = TRUE),
stickiness_score = 1 - avg_churn
)
print(retention_by_product)
## # A tibble: 3 × 3
## Area.di.Bisogno avg_churn stickiness_score
## <fct> <dbl> <dbl>
## 1 Previdenza 0.190 0.810
## 2 Protezione 0.240 0.760
## 3 Risparmio e Investimento 0.241 0.759
Commenti:
# Creazione dummy variabili
polizze_dummies <- polizze %>%
filter(Stato_Polizza == "Attiva") %>%
dplyr::select(codice_cliente, Area.di.Bisogno) %>%
distinct() %>%
mutate(value = 1) %>%
pivot_wider(
names_from = Area.di.Bisogno,
values_from = value,
values_fill = 0,
names_prefix = "has_"
)
clienti_model <- clienti %>%
left_join(polizze_dummies, by = "codice_cliente") %>%
mutate(across(starts_with("has_"), ~replace_na(., 0))) %>%
filter(Churn_Probability != 1) %>%
dplyr::select(
-Nome, -Cognome, -Luogo.di.Nascita, -Luogo.di.Residenza,
-codice_cliente, -Agenzia, -Latitudine, -Longitudine, -Data_Ultima_Visita
) %>%
mutate(
log_Reddito = log(Reddito + 1),
log_Patrimonio_Fin = log(Patrimonio.Finanziario.Stimato + 1),
quad_eta = I(Età^2),
Num_Polizze_centered = Num_Polizze - mean(Num_Polizze, na.rm = TRUE),
Fascia_Eta = case_when(
Età < 30 ~ "Under_30",
Età < 45 ~ "30_45",
Età < 60 ~ "45_60",
TRUE ~ "Over_60"
),
is_multipolizza = ifelse(Num_Polizze > 1, 1, 0)
)
# Riscalamento risposta [0-1]
model_data <- clienti_model
model_data$Churn_scaled <- model_data$Churn_Probability / max(model_data$Churn_Probability)
# Variabili predittive
predictors_available <- c(
"Num_Polizze", "has_Protezione", "has_Risparmio_e_Investimento", "has_Previdenza",
"Età", "quad_eta", "Stato.Civile", "Professione", "Consumi.Stimati",
"Anzianità.con.la.Compagnia", "Reclami_Totali", "Visite_Ultimo_Anno",
"Potenziale_Crescita"
)
predictors_available <- predictors_available[predictors_available %in% names(model_data)]
formula_full <- as.formula(paste(
"Churn_scaled ~",
paste(predictors_available, collapse = " + ")
))
model_full <- glm(formula_full, family = quasibinomial(link = "logit"), data = model_data)
# Stepwise selection con quasibinomial non supporta AIC
# Usiamo binomial per la selezione, poi rifit con quasibinomial
model_full_binom <- glm(formula_full, family = binomial(link = "logit"), data = model_data)
model_step_both <- stepAIC(model_full_binom, direction = "both", trace = 0)
# Rifit del modello selezionato con quasibinomial
model_final <- glm(formula(model_step_both), family = quasibinomial(link = "logit"), data = model_data)
summary(model_final)
##
## Call:
## glm(formula = formula(model_step_both), family = quasibinomial(link = "logit"),
## data = model_data)
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.7808803 0.0127562 61.22 <2e-16 ***
## Num_Polizze -0.3032614 0.0056083 -54.07 <2e-16 ***
## Anzianità.con.la.Compagnia -0.0626074 0.0007243 -86.44 <2e-16 ***
## Visite_Ultimo_Anno -0.0738573 0.0040719 -18.14 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for quasibinomial family taken to be 0.0765065)
##
## Null deviance: 2313.78 on 9999 degrees of freedom
## Residual deviance: 840.03 on 9996 degrees of freedom
## AIC: NA
##
## Number of Fisher Scoring iterations: 4
odds_ratios <- exp(coef(model_final))
print(odds_ratios)
## (Intercept) Num_Polizze
## 2.1833935 0.7384061
## Anzianità.con.la.Compagnia Visite_Ultimo_Anno
## 0.9393121 0.9288042
Interpretazione:
predictors_nba <- c("Num_Polizze", "Anzianità.con.la.Compagnia", "Visite_Ultimo_Anno")
formula_nba <- as.formula(paste("Churn_scaled ~", paste(predictors_nba, collapse = " + ")))
model_nba <- glm(formula_nba, data = model_data, family = quasibinomial(link = "logit"))
summary(model_nba)
##
## Call:
## glm(formula = formula_nba, family = quasibinomial(link = "logit"),
## data = model_data)
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.7808803 0.0127562 61.22 <2e-16 ***
## Num_Polizze -0.3032614 0.0056083 -54.07 <2e-16 ***
## Anzianità.con.la.Compagnia -0.0626074 0.0007243 -86.44 <2e-16 ***
## Visite_Ultimo_Anno -0.0738573 0.0040719 -18.14 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for quasibinomial family taken to be 0.0765065)
##
## Null deviance: 2313.78 on 9999 degrees of freedom
## Residual deviance: 840.03 on 9996 degrees of freedom
## AIC: NA
##
## Number of Fisher Scoring iterations: 4
Esempio:
calcola_delta_churn <- function(p_attuale_scalata, coef_polizza = -0.303, max_churn = 0.62) {
p_norm <- p_attuale_scalata / max_churn
p_norm <- pmax(0.001, pmin(0.999, p_norm))
logit_attuale <- log(p_norm / (1 - p_norm))
logit_nuovo <- logit_attuale + coef_polizza
p_nuova_norm <- exp(logit_nuovo) / (1 + exp(logit_nuovo))
p_nuova_scalata <- p_nuova_norm * max_churn
delta <- p_attuale_scalata - p_nuova_scalata
return(delta)
}
# Test
risparmio <- calcola_delta_churn(0.40)
cat("Con churn iniziale 0.40, il churn calerebbe di:", round(risparmio, 4), "\n")
## Con churn iniziale 0.40, il churn calerebbe di: 0.0446
Analisi delle redditività e delle caratteristiche dei prodotti (spoiler: sarebbe stato meglio farla per prima)
Danni, Previdenza+Risparmio
pol_danni <- subset(polizze, Area.di.Bisogno == "Protezione", select = -c(Area.di.Bisogno))
pol_previdenza <- subset(polizze, Area.di.Bisogno == "Previdenza", select = -c(Area.di.Bisogno))
pol_risparmio <- subset(polizze, Area.di.Bisogno == "Risparmio e Investimento", select = -c(Area.di.Bisogno))
ggplot(pol_risparmio, aes(x = Data.di.Emissione, fill = Stato_Polizza)) +
geom_histogram(bins = 30, alpha = 0.5, position = "identity") +
labs(title = "Distribuzione Date Emissione per Stato Polizza - Risparmio",
x = "Data Emissione", y = "Frequenza") +
theme_minimal()
Due prodotti:
pol_previdenza$Anno <- as.numeric(format(pol_previdenza$Data.di.Emissione, "%Y"))
pol_previdenza$Totale_Versato <- (pol_previdenza$Premio_Ricorrente * (2026 - pol_previdenza$Anno))
pol_previdenza$Cap_Gain <- pol_previdenza$Capitale_Rivalutato - pol_previdenza$Totale_Versato
n_premio_unico <- sum(!is.na(pol_previdenza$Premio_Unico) & is.na(pol_previdenza$Premio_Ricorrente))
cat("Polizze con solo premio unico:", n_premio_unico, "\n")
## Polizze con solo premio unico: 35
outliers <- boxplot(pol_previdenza$Cap_Gain, plot = FALSE)$out
hist(pol_previdenza$Cap_Gain[!pol_previdenza$Cap_Gain %in% outliers],
main = "Capital Gain (eccetto outlier)",
xlab = "Cap Gain", col = "lightblue", breaks = 30)
Importante: Non avendo dati sui rendimenti dei fondi, per stimare la redditività bisogna usare i rendimenti dei fondi citati come parte del prodotto (es. rendimenti GESAV, fondi OICR?).
Su https://www.generali-investments.com/it/it/institutional/fund-page/fondo-alto-fondo-alto-internazionale-obbligazionario-b-IT0005254369 ci sono dei fondi
| Caratteristica | Gestione Separata (GESAV) | Fondo OICR |
|---|---|---|
| Capitale | Garantito | A rischio |
| Rendimento | Minimo garantito + rivalutazione | Variabile, può essere negativo |
| Prodotti | PIP, polizze Ramo I | Polizze Unit-Linked (Ramo III) |
| Trasparenza | Rendiconto annuale pubblico | NAV giornaliero |
| Liquidità | Limitata (vincoli contrattuali) | Alta (riscatto quote) |
pol_danni$Anno <- as.numeric(format(pol_danni$Data.di.Emissione, "%Y"))
pol_danni$Totale_Versato <- (pol_danni$Premio_Ricorrente * (2026 - pol_danni$Anno))
pol_danni$Totale_Versato[is.na(pol_danni$Premio_Ricorrente)] <-
pol_danni$Premio_Unico[is.na(pol_danni$Premio_Ricorrente)] *
(2026 - pol_danni$Anno[is.na(pol_danni$Premio_Ricorrente)])
pol_danni$Loss_Ratio <- pol_danni$Sinistri_Totali / pol_danni$Totale_Versato
pol_danni <- subset(pol_danni, !is.na(Premio_Ricorrente))
pol_casa <- subset(pol_danni, Prodotto == "Assicurazione Casa e Famiglia: Casa Serena")
pol_salute <- subset(pol_danni, Prodotto == "Polizza Salute e Infortuni: Salute Protetta")
pol_params <- pol_danni %>%
filter(Stato_Polizza == "Attiva") %>%
dplyr::select(Premio_Ricorrente, Commissione_Perc, Costi_Operativi)
pairs(pol_params,
main = "Matrice Scatterplot - Parametri Contrattuali",
pch = 19,
col = rgb(0, 0, 0, 0.05))
pol_params_canale <- pol_danni %>%
filter(Stato_Polizza == "Attiva") %>%
dplyr::select(Premio_Ricorrente, Commissione_Perc, Costi_Operativi, Canale_Acquisizione)
canali_unici <- unique(pol_params_canale$Canale_Acquisizione)
colori <- c("blue", "red")
col_mapping <- setNames(colori[1:length(canali_unici)], canali_unici)
col_punti <- col_mapping[pol_params_canale$Canale_Acquisizione]
pairs(pol_params_canale[,1:3],
main = "Parametri per Canale di Acquisizione",
pch = 19,
col = adjustcolor(col_punti, alpha.f = 0.4))
par(xpd = TRUE)
legend("topright", legend = names(col_mapping), col = col_mapping, pch = 19, title = "Canale")
par(xpd = FALSE)
Osservazione: Commissioni NON dipendono dal Canale_Acquisizione
ggplot(pol_danni, aes(x = Commissione_Perc, fill = Stato_Polizza)) +
geom_histogram(binwidth = 0.005, alpha = 0.6, position = "identity") +
labs(title = "Distribuzione Commissioni per Stato Polizza",
x = "Commissione %", y = "Frequenza") +
theme_minimal()
pol_danni_tempo <- pol_casa %>%
mutate(
Anno_Emissione = as.numeric(format(as.Date(Data.di.Emissione), "%Y")),
gruppo_commissione = ifelse(Commissione_Perc < 0.12, "Basse (<12%)", "Alte (≥12%)")
)
ggplot(pol_danni_tempo,
aes(x = jitter(Anno_Emissione, 2), y = Commissione_Perc, color = Stato_Polizza)) +
geom_point(alpha = 0.5, size = 2) +
geom_smooth(method = "loess", se = FALSE) +
geom_hline(yintercept = mean(pol_danni_tempo$Commissione_Perc),
linetype = "dashed", color = "red") +
labs(title = "Evoluzione Commissioni nel Tempo per Stato Polizza",
x = "Anno di Emissione", y = "Commissione %") +
theme_minimal()
Osservazione: Commissioni cambiate nel tempo (passaggio da ~12% a livelli più bassi).
pol_danni <- pol_danni %>%
mutate(
Data_Fine_Analisi = ifelse(is.na(Data_Scadenza),
as.Date("2025-12-31"), Data_Scadenza),
Data_Fine_Analisi = as.Date(Data_Fine_Analisi, origin = "1970-01-01"),
Anni_Polizza = as.numeric(difftime(Data_Fine_Analisi,
as.Date(Data.di.Emissione),
units = "days")) / 365.25
)
redditivita_danni <- pol_danni %>%
group_by(Prodotto) %>%
summarise(
Numero_Contratti = n(),
Anni_Cumulati = sum(Anni_Polizza, na.rm = TRUE),
Premi_Totali = sum(Totale_Versato, na.rm = TRUE),
Sinistri_Totali = sum(Sinistri_Totali, na.rm = TRUE),
Margine_Tecnico = Premi_Totali - Sinistri_Totali,
Margine_Medio_Annuo_Contratto = Margine_Tecnico / Anni_Cumulati,
Margine_medio_Contratto = Margine_Tecnico / n(),
Loss_Ratio = (Sinistri_Totali / Premi_Totali) * 100
) %>%
arrange(desc(Margine_Medio_Annuo_Contratto))
# Formatta la tabella per migliore visualizzazione
redditivita_danni_formatted <- redditivita_danni %>%
mutate(
Prodotto = gsub("Assicurazione Casa e Famiglia: ", "", Prodotto),
Prodotto = gsub("Polizza Salute e Infortuni: ", "", Prodotto),
Premi_Totali = scales::comma(round(Premi_Totali, 0)),
Sinistri_Totali = scales::comma(round(Sinistri_Totali, 0)),
Margine_Tecnico = scales::comma(round(Margine_Tecnico, 0)),
Margine_Medio_Annuo_Contratto = scales::comma(round(Margine_Medio_Annuo_Contratto, 2)),
Margine_medio_Contratto = scales::comma(round(Margine_medio_Contratto, 0)),
Loss_Ratio = paste0(round(Loss_Ratio, 1), "%")
)
knitr::kable(redditivita_danni_formatted,
caption = "Analisi Redditività Prodotti Danni",
align = c("l", rep("r", 7)))
| Prodotto | Numero_Contratti | Anni_Cumulati | Premi_Totali | Sinistri_Totali | Margine_Tecnico | Margine_Medio_Annuo_Contratto | Margine_medio_Contratto | Loss_Ratio |
|---|---|---|---|---|---|---|---|---|
| Salute Protetta | 5132 | 5536.893 | 25,070,416 | 3,947,380 | 21,123,036 | 3,815 | 4,116 | 15.7% |
| Casa Serena | 5455 | 6055.715 | 21,723,591 | 10,642,582 | 11,081,009 | 1,830 | 2,031 | 49% |
================================================================================
6. Interazioni
================================================================================
Idea: stimare una probabilità di successo in base alle conversioni passate, per metodo di contatto.
Problema: non viene detto che tipo di prodotto è oggetto della conversazione e non sembra esserci corrispondenza reale con i prodotti posseduti dai clienti in quelle date (da verificare).
Da capire se fattibile proporre il metodo di contatto ottimale, magari usando il sistema RAG ecc.
Esempio output finale:
## Output per consulenti
I pesi dovrebbero riflettere le **priorità strategiche**:
| Scenario | w_comp | w_redd | w_ret | w_prob |
|----------|--------|--------|-------|--------|
| **Focus retention** | 0.20 | 0.20 | 0.40 | 0.20 |
| **Focus profitability** | 0.20 | 0.45 | 0.15 | 0.20 |
| **Balanced** | 0.25 | 0.30 | 0.20 | 0.25 |
| **Quick wins** | 0.15 | 0.20 | 0.15 | 0.50 |
## Output per consulenti
Dashboard con:
Cliente: Mario Rossi
Cluster: Famiglie Giovani Urbane
Polizze attuali: Casa Serena
TOP 3 RACCOMANDAZIONI:
1. Salute Protetta [Score: 87/100]
→ Compatibilità: 92% | Redditività: ★★★★ | Prob. successo: 78%
2. Futuro Sicuro [Score: 73/100]
→ Compatibilità: 65% | Redditività: ★★★★★ | Prob. successo: 71%
3. Pensione Serenità [Score: 54/100]
→ Compatibilità: 48% | Redditività: ★★★ | Prob. successo: 62%